#!/usr/bin/perl
 
#===============
# * 2013 Copyright Matthew Caswell
# * Pool.pl
#-------
# * Pool language translator/compiler.
# * P.O.O.L - Perl Object Oriented Language
#===============
 
use strict;
use Data::Dumper;
 
use constant POOL_VERSION => "A30r03";
my $POOL_VERSION = "A30r03";
 
print "This is Pool/".POOL_VERSION."\n";
 
unless($#ARGV >= 1){
  die "Usage: Pool.pl <+[c]> <Pool_class> <Pool_export_class>\n";
}
 
my($CMDLSwitch, $PoolClassFile, $PoolExportClassFile) = @ARGV[0..2];
 
print "[Debug] Looding pool class\n";
 
$PoolClassFile .= ".pool";
$PoolExportClassFile .= ".pm";
 
open my$PoolClassFileHandler, $PoolClassFile
  or die "[STDERR] Could not open $PoolClassFile!\n[Perl] ". $! . "\n";

my $PoolClass = do{ local $/; <$PoolClassFileHandler> };
  
close($PoolClassFileHandler);
 
print "[Debug] Starting package constructor\n";
 
my $POOLedPackage = "use strict;\n\n";
 
print "[Debug] Starting Pool fragmentation\n";
my @lines = grep length, split /\n/, $PoolClass;
 
my $inClass = 0;
my $POOLedPackageNameStub;
my $PackageSet = 0;
my $InternalOn;
my $localOn;
my $inExport;
my $POOLedPackageOriginalName;
my $inlineState = 0;
# PACKAGE
for my$index (0..$#lines){
  my $lineNu = $index+1;
  my @thisline = grep length, split /[\s\(\)]/, $lines[$index];
  if($thisline[0] eq "package"){
    print "[Debug] Found package\n";
    my @packName = grep length, split '', $thisline[1];
    if($packName[$#packName] eq ';'){
      $thisline[1] = join('', @packName[0..$#packName-1]);
      $POOLedPackageOriginalName = $thisline[1];
      @packName = grep length, split /\./, $thisline[1];
      my $POOLPackName;
 #    print Dumper(@packName);
      if($#packName != 0){
        print "[Debug] Fixing package name\n";
        $POOLPackName = join("::", @packName);
      }else{
        $POOLPackName = $thisline[1];
      }
      $POOLedPackageNameStub .= "package $POOLPackName";
    }else{
      die "[STDERR] In line $lineNu: ';' expected at EOL\n";
    }
  }elsif($thisline[0] eq "export" && $inClass == 0){
    print "[Debug] Found export\n";
    my @className = grep length, split '', $thisline[1];
    my $RealClassName;
    if($className[$#className] eq "{"){
      $RealClassName = join('', @className[0..$#className-1]);
    }else{
      $RealClassName = join('', @className);
    }
    print "[Debug] Fixing class names\n";
    $POOLedPackage .= <<EOF;
#===============================================
# * This Perl module has been generated by     *
# * Matthew Caswell's original Pool compiler   *
# * (which was also written in Perl).          *
# * The data and text below should be correct, *
# * and should follow the basic structure of   *
# * a Pool export class (which is translated   *
# * to Perl and stuck in a module).            *
# * ------------------------------------------ *
# * This module's original name:               *
# * $PoolExportClassFile                       
# * This module's original package name:       *
# * $POOLedPackageOriginalName                     
# * This module's original class name:         *
# * $RealClassName                             
# *   --\$\$-- Pool/$POOL_VERSION              
#===============================================
EOF
    $POOLedPackage .= $POOLedPackageNameStub . "::" . $RealClassName . ";\n\n";
    $POOLedPackage .= <<EOF;
my \$internal = {};
 
EOF
    $inClass = 1;
    $PackageSet = 1;
  }elsif($thisline[0] eq "export" && $inClass == 1){
    print "[Debug] Found method export\n";
    $inExport = 1;
    #print Dumper(@thisline);
    my $exportName = $thisline[2];
    $POOLedPackage .= "\nsub $exportname{\n  my(\$internal";
    if($thisline[3] eq "vector"){
      $POOLedPackage .= ", \@$thisline[4]) = \@_;\n";
    }elsif($thisline[3] eq "void"){
      $POOLedPackage .= ") = shift;\n";
    elsif($thisline[3] eq "string" || $thisline[3] eq "int"){
      $POOLedPackage .= ", \$$thisline[4]) = \@_;\n";
    }else{
      die "[STDERR] In line $lineNu: unknown type used in export method\n";
    }
  }elsif($thisline[0] eq "internal"){
    print "[Debug] Found method internal\n";
    #print Dumper(@thisline);
    my $internalName = $thisline[2];
    $POOLedPackage .= "\$internal = {\n  $internalName => sub{\n    my(\$internal";
    if($thisline[3] eq "vector"){
      $POOLedPackage .= ", \@$thisline[4]) = \@_;\n";
    }elsif($thisline[3] eq "void"){
      $POOLedPackage .= ") = shift;\n";
    elsif($thisline[3] eq "string" || $thisline[3] eq "int"){
      $POOLedPackage .= ", \$$thisline[4]) = \@_;\n";
    }else{
      die "[STDERR] In line $lineNu: unknown type in internal method\n";
    }
    $InternalOn = 1;
  }elsif($thisline[0] eq "Console.println"){
    $POOLedPackage .= "print STDOUT ";
    my@cc = grep length, split '', $thisline[1];
    if($cc[0] eq "\""){
      my @fry = @thisline[1..$#thisline];
      foreach my$meh (@fry){
        $POOLedPackage .= $meh . " ";
      }
    }elsif($thisline[1] eq "vector"){
    $POOLedPackage .= "\@".$thisline[2].";";
    }elsif($thisline[1] eq "string"){
      $POOLedPackage .= "\$".$thisline[2].";";
    }elsif($thisline[1] eq "int"){
      $POOLedPackage .= "\$".$thisline[2].";";
    }elsif($thisline[1] eq "meth.i"){
      $POOLedPackage .= "\$internal->{".$thisline[2]."}(";
      if($thisline[3] eq "vector"){
        $POOLedPackage .= "\@".$thisline[4].");";
      }elsif($thisline[3] eq "string"){
        $POOLedPackage .= "\$$thisline[4]);";
      }elsif($thisline[3] eq "int"){
        $POOLedPackage .= "\$$thisline[4]);";
      }elsif($thisline[3] eq "void"){
        $POOLedPackage .= ");";
      }else{
        die "[STDERR] In line $lineNu: unknown type used in meth.i\n";
      }
    }elsif($thisline[1] eq "meth.e"){
      my @nameOfClass = grep length, split /\./, $thisline[2];
      my $nameReal;
      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[1];
      }
      
      $POOLedPackage .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[3];
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @thisline[3..$#thisline-1]);
        $POOLedPackage .= ");\n";
      }elsif($thisline[3] eq "vector"){
        $POOLedPackage .= "\@".$thisline[4].");\n";
      }elsif($thisline[3] eq "void"){
        $POOLedPackage .= ");\n";
      }elsif($thisline[3] eq "string"){
        $POOLedPackage .= "\$$thisline[4]);";
      }elsif($thisline[3] eq "int"){
        $POOLedPackage .= "\$$thisline[4]);";
      }else{
        die "[STDERR] In line $lineNu: unknown type in meth.e\n";
      }
    }else{
      die "[STDERR] In line $lineNu: unknown type used in Console.println\n";
    }
    $POOLedPackage .= "\n";
  }elsif($thisline[0] eq "}" && $inlineState == 0){
    if($InternalOn == 1){
      $POOLedPackage .= <<EOF;
  },
};
EOF
      $InternalOn = 0;
    }elsif($inClass == 1 && $InternalOn == 0
      && $inExport == 0){
      $POOLedPackage .= "\n1;";
      $inClass = 0;
    }elsif($inExport == 1 && $inClass == 1){
      $POOLedPackage .= "\n}\n";
      $inExport = 0;
    }else{
      die "[STDERR] In line $lineNu: stray }\n";
    }
  }elsif($thisline[0] eq "this.method"){
    my $internalMethodCallName = "\$internal->{$thisline[1]}(\$internal, ";
    my @cc = grep length, split '', $thisline[2];
    if($cc[0] eq "\""){
      $internalMethodCallName .= "(".join(" ", @thisline[2..$#thisline-1])."))";
    }elsif($thisline[2] eq "vector"){
      $internalMethodCallName .= "(\@".$thisline[3].")";
    }elsif($thisline[2] eq "void"){
      $internalMethodCallName .= "()";
    }elsif($thisline[2] eq "string"){
      $internalMethodCallName .= "\$".$thisline[3].")";
    }elsif($thisline[2] eq "int"){
      $internalMethodCallName .= "\$".$thisline[3].")";
    }elsif($thisline[2] eq "meth.i"){
      $internalMethodCallName .= "\$internal->{$thisline[3]}(";
      if($thisline[4] eq "vector"){
        $internalMethodCallName .= "\@".$thisline[5]."))";
      }elsif($thisline[4] eq "string"){
        $internalMethodCallName .= "\$$thisline[5]))";
      }elsif($thisline[4] eq "int"){
        $internalMethodCallName .= "\$$thisline[5]))";
      }elsif($thisline[4] eq "void"){
        $internalMethodCallName .= "))";
      }else{
        die "[STDERR] In line $lineNu: unknown type used in meth.i\n";
      }
    }elsif($thisline[3] eq "meth.e"){
      my @nameOfClass = grep length, split /\./, $thisline[4];
      my $nameReal;
      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[4];
      }
      
      $internalMethodCallName .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[5];
      if($cc[0] eq "\""){
        $internalMethodCallName .= join(" ", @thisline[5..$#thisline-1]);
        $internalMethodCallName .= ")";
      }elsif($thisline[5] eq "vector"){
        $internalMethodCallName .= "\@".$thisline[6].")";
      }elsif($thisline[5] eq "void"){
        $internalMethodCallName .= ")\n";
      }elsif($thisline[5] eq "string"){
        $internalMethodCallName .= "\$$thisline[6])";
      }elsif($thisline[5] eq "int"){
        $internalMethodCallName .= "\$$thisline[6])";
      }else{
        die "[STDERR] In line $lineNu: unknown type in meth.e\n";
      }
    }else{
      die "[STDERR] In line $lineNu: unknown type in this.method ()\n";
    }
    $POOLedPackage .= "$internalMethodCallName;\n";
  }elsif($thisline[0] eq "import"){
    print "[Debug] Found imported package\n";
    my @importPackageArray = grep length, split '', $thisline[1];
    if($importPackageArray[$#importPackageArray] eq ";"){
      my $importPackageName = join('', @importPackageArray[0..$#importPackageArray-1]);
      @importPackageArray = grep length, split /\./, $importPackageName;
      $importPackageName = join("::", @importPackageArray);
      $POOLedPackage .= "use $importPackageName;\n";
    }else{
      die "[STDERR] In line $lineNu: Syntax error at end of line: ';' expected\n";
    }
  }elsif($thisline[0] eq "method"){
    @thisline = grep length, split /[\s\(\)]/, $lines[$index];
    my @nameOfClass = grep length, split /\./, $thisline[1];
    my $nameReal;
    if($#nameOfClass != 0){
      $nameReal = join("::", @nameOfClass);
    }else{
      $nameReal = $thisline[1];
    }
    $POOLedPackage .= $nameReal . "(";
    
    my @cc = grep length, split '', $thisline[2];
    if($cc[0] eq "\""){
      $POOLedPackage .= join(" ", @thisline[2..$#thisline-1]);
      $POOLedPackage .= ");\n";
    }elsif($thisline[2] eq "vector"){
      $POOLedPackage .= "\@".$thisline[3].");\n";
    }elsif($thisline[2] eq "void"){
      $POOLedPackage .= ");\n";
    }elsif($thisline[2] eq "string"){
      $POOLedPackage .= "\$".$thisline[3].");\n";
    }elsif($thisline[2] eq "int"){
     $POOLedPackage .= "\$".$thisline[3].");\n";
    }elsif($thisline[2] eq "meth.i"){
      $POOLedPackage .= "\$internal->{".$thisline[3]."}(";
      if($thisline[4] eq "vector"){
        $POOLedPackage .= "\@".$thisline[5].")";
      }elsif($thisline[4] eq "string"){
        $POOLedPackage .= "\$$thisline[5])";
      }elsif($thisline[4] eq "int"){
        $POOLedPackage .= "\$$thisline[5])";
      }elsif($thisline[4] eq "void"){
        $POOLedPackage .= ");\n";
      }else{
        die "[STDERR] In line $lineNu: unknown type used in meth.i\n";
      }
    }elsif($thisline[3] eq "meth.e"){
      @nameOfClass = grep length, split /\./, $thisline[4];
      $nameReal;
      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[4];
      }
      
      $POOLedPackage .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[5];
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @thisline[5..$#thisline-1]);
        $POOLedPackage .= ");\n";
      }elsif($thisline[5] eq "vector"){
        $POOLedPackage .= "\@".$thisline[6].");\n";
      }elsif($thisline[5] eq "void"){
        $POOLedPackage .= ");\n";
      }elsif($thisline[5] eq "string"){
        $POOLedPackage .= "\$$thisline[6]);\n";
      }elsif($thisline[5] eq "int"){
        $POOLedPackage .= "\$$thisline[6]);\n";
      }else{
        die "[STDERR] In line $lineNu: unknown type in meth.e\n";
      }
    }else{
      die "[STDERR] In line $lineNu: unknown type in method ()\n";
    }
  }elsif($thisline[0] eq "__inline.Perl__"
    && $inlineState == 0){
    $inlineState = 1;
    print "[Debug] inlineState is true\n";
  }elsif($thisline[0] ne "__inline.end__"
    && $inlineState == 1){
    $POOLedPackage .= $lines[$index]."\n";
  }elsif($inlineState == 1 && $thisline[0] eq "__inline.end__"){
    print "[Debug] inlineState is false\n";
    $inlineState = 0;
  }elsif($inlineState == 0 && $thisline[0] eq "__inline.end__"){
    die "[STDERR] In line $lineNu: __inline.end__ called when inlineState is false!\n";
  }elsif($thisline[0] eq "return" && ($inExport == 1 || $InternalOn == 1)){
    $POOLedPackage .= "return ";
    if($thisline[1] eq "vector"){
      $POOLedPackage .= "\@".$thisline[2];
    }elsif($thisline[1] eq "string"){
      $POOLedPackage .= "\$".$thisline[2];
    }elsif($thisline[1] eq "int"){
      $POOLedPackage .= "\$".$thisline[2];
    }elsif($thisline[1] eq "meth.i"){
      $POOLedPackage .= "\$internal->{".$thisline[2]."}(";
      if($thisline[3] eq "vector"){
        $POOLedPackage .= "\@".$thisline[4].")";
      }elsif($thisline[3] eq "string"){
        $POOLedPackage .= "\$$thisline[4])";
      }elsif($thisline[3] eq "int"){
        $POOLedPackage .= "\$$thisline[4])";
      }elsif($thisline[3] eq "void"){
        $POOLedPackage .= ")";
      }else{
        die "[STDERR] In line $lineNu: unknown type used in meth.i\n";
      }
    }elsif($thisline[1] eq "meth.e"){
      my @nameOfClass = grep length, split /\./, $thisline[2];
      my $nameReal;
      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[1];
      }
      
      $POOLedPackage .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[3];
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @thisline[3..$#thisline-1]);
        $POOLedPackage .= ");\n";
      }elsif($thisline[3] eq "vector"){
        $POOLedPackage .= "\@".$thisline[4].");\n";
      }elsif($thisline[3] eq "void"){
        $POOLedPackage .= ");\n";
      }elsif($thisline[3] eq "string"){
        $POOLedPackage .= "\$$thisline[4])";
      }elsif($thisline[3] eq "int"){
        $POOLedPackage .= "\$$thisline[4])";
      }else{
        die "[STDERR] In line $lineNu: unknown type in meth.e\n";
      }
    }else{
      die "[STDERR] In line $lineNu: unknown type used in return()\n";
    }
    $POOLedPackage .= ";\n";
  }elsif($thisline[0] eq "var"){
    if($thisline[1] eq "vector"){
      if($thisline[3] eq "="){
       $POOLedPackage .= "my \@$thisline[2] = (".join(" ", @thisline[4..$#thisline-1]);
       $POOLedPackage .= ");\n";
      }else{
        die "[STDERR] In line $lineNu: Operator expected\n";
      }
    }elsif($thisline[1] eq "string" || $thisline[1] eq "int"){
      if($thisline[3] eq "="){
        $POOLedPackage .= "my \$$thisline[2] = ";
        $POOLedPackage .= join(" ", @thisline[4..$#thisline]);
        $POOLedPackage .= "\n";
      }else{
        die "[STDERR] In line $lineNu: Operator expected\n";
      }
    }else{
      die "[STDERR] In line $lineNu: unknown type used in var declaration\n";
    }
  }
}
 
print "[Debug] Creating PoolExportClass handle and class\n";
open my$PoolExportClassHandler, ">$PoolExportClassFile"
  or die "[STDERR] Couldn't open or create $PoolExportClassFile!\n[Perl] " . $! . "\n";
  
print "[Debug] Unloading export class\n";
print $PoolExportClassHandler $POOLedPackage;
 
close($PoolExportClassHandler);
 
print "[Done]\n"
